home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / MacScheme20 / Mathlib / ppa.scm < prev    next >
Encoding:
Text File  |  1989-04-27  |  2.4 KB  |  77 lines  |  [TEXT/????]
  1. ;;;;        PPA:  Piecewise polynomial approximations
  2.  
  3. ;;;   To make a piecewise polynomial approximation of a function, f,
  4. ;;;   we specify the range, [low, high], the maximum order of polynomial 
  5. ;;;   that fits may be made with, and the accuracy required.
  6.  
  7. (define (make-ppa f low high max-order accuracy)
  8.   (let* ((c (/ (+ low high) 2))
  9.          (d (/ (- high low) 2))
  10.          (g (lambda (x) (f (+ x c))))
  11.          (result (get-poly-and-errors g (- d) d max-order))
  12.          (p (car result))
  13.          (eps (cadr result)))
  14.     (if (< eps accuracy)
  15.         (ppa-make-from-poly low high 
  16.                             (cheb-econ p low high (- accuracy eps)))
  17.         (let ((mid (/ (+ low high) 2)))
  18.           (ppa-adjoin (make-ppa f low mid max-order accuracy)
  19.                       (make-ppa f mid high max-order accuracy))))))
  20.  
  21.  
  22. ;;; PPA-VALUE will evaluate a PPA at any given point, x.
  23.  
  24. (define (ppa-value ppa x)
  25.   (define (ppa-search low high body)
  26.     (cond ((ppa-terminal? body)
  27.            (poly-value (ppa-poly body) (- x (/ (+ low high) 2))))
  28.           ((ppa-split? body)
  29.            (let ((s (ppa-split body)))
  30.              (if (< x s)
  31.                  (ppa-search low s (ppa-low-side body))
  32.                  (ppa-search s high (ppa-high-side body)))))
  33.           (else (error "Bad body -- PPA-SEARCH"))))
  34.   (let ((low (ppa-low-bound ppa))
  35.         (high (ppa-high-bound ppa)))
  36.     (if (and (<= low x) (<= x high))
  37.         (ppa-search low high (ppa-body ppa))
  38.         (error "Out of bounds -- PPA-VALUE"))))
  39.  
  40.  
  41. ;;; We may use PPAs to memoize functions.
  42.  
  43. (define (ppa-memo f low high max-order accuracy)
  44.   (let ((ppa (make-ppa f low high max-order accuracy)))
  45.     (lambda (x) (ppa-value ppa x))))
  46.  
  47. ;;; Implementation of PPA data structures
  48.  
  49. (define (ppa-make-from-poly low high poly)
  50.   (cons (cons low high) 
  51.         (cons 'ppa-terminal poly)))
  52.  
  53. (define (ppa-adjoin ppalow ppahigh)
  54.   (if (= (cdar ppalow) (caar ppahigh))
  55.       (cons (cons (caar ppalow) (cdar ppahigh))
  56.             (cons 'ppa-split
  57.                   (cons (cdar ppalow)
  58.                         (cons (cdr ppalow) (cdr ppahigh)))))
  59.       (error "PPAs not adjacent -- PPA-ADJOIN")))
  60.  
  61. (define ppa-low-bound caar)
  62. (define ppa-high-bound cdar)
  63.  
  64. (define ppa-body cdr)
  65.  
  66. (define (ppa-terminal? b)
  67.   (eq? (car b) 'ppa-terminal))
  68. (define ppa-poly cdr)
  69.  
  70.  
  71. (define (ppa-split? b)
  72.   (eq? (car b) 'ppa-split))
  73.  
  74. (define ppa-split cadr)
  75. (define ppa-low-side caddr)
  76. (define ppa-high-side cdddr)
  77.